Lab 3 - Checkpoint 3
Arnaldo Gualberto
9 de maio de 2017
0. Imports and Settings
library(broom)
library(cluster)
library(dplyr, warn.conflicts = FALSE)
library(GGally, warn.conflicts = FALSE)
library(ggdendro)
library(ggplot2)
library(ggfortify)
library(highcharter, quietly = TRUE)## Highcharts (www.highcharts.com) is a Highsoft software product which is## not free for commercial and Governmental uselibrary(knitr)
library(readr)
library(tibble)
library(tidyr)
require(Rtsne, quietly = TRUE)
source('multiplot.R')1. Análise Descritiva
dados_all <- read_csv("data/capes-cacc.csv")
glimpse(dados_all)## Observations: 75
## Variables: 31
## $ Instituição <chr> "UNIVERSIDADE FEDERAL DO AMAZONAS",...
## $ Programa <chr> "INFORMÁTICA (12001015012P2)", "CIÊ...
## $ Nível <int> 5, 4, 3, 3, 3, 5, 4, 3, 3, 3, 5, 3,...
## $ Sigla <chr> "UFAM", "UFPA", "UFMA", "UEMA", "FU...
## $ Tem doutorado <chr> "Sim", "Sim", "Não", "Não", "Não", ...
## $ Docentes colaboradores <dbl> 0.25, 5.50, 3.00, 6.25, 1.75, 2.00,...
## $ Docentes permanentes <dbl> 24.75, 14.00, 10.00, 14.00, 9.50, 2...
## $ Docentes visitantes <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.75,...
## $ Resumos em conf <int> 20, 23, 15, 5, 4, 10, 6, 136, 0, 24...
## $ Resumos expandidos em conf <int> 25, 24, 7, 10, 1, 68, 9, 13, 4, 6, ...
## $ Artigos em conf <int> 390, 284, 115, 73, 150, 269, 179, 0...
## $ Dissertacoes <int> 108, 77, 50, 25, 31, 75, 60, 129, 4...
## $ Teses <int> 14, NA, NA, NA, NA, 24, 5, NA, NA, ...
## $ periodicos_A1 <int> 15, 19, 5, 1, 7, 21, 21, 0, 3, 8, 4...
## $ periodicos_A2 <int> 19, 21, 11, 1, 4, 32, 13, 0, 9, 2, ...
## $ periodicos_B1 <int> 19, 38, 7, 3, 6, 26, 16, 2, 6, 4, 3...
## $ periodicos_B2 <int> 1, 12, 2, 6, 0, 0, 11, 0, 0, 2, 1, ...
## $ periodicos_B3 <int> 3, 16, 2, 2, 3, 16, 15, 0, 4, 6, 9,...
## $ periodicos_B4 <int> 0, 4, 0, 3, 3, 0, 1, 3, 1, 6, 0, 0,...
## $ periodicos_B5 <int> 10, 16, 8, 4, 12, 4, 16, 2, 6, 2, 1...
## $ periodicos_C <int> 9, 34, 12, 5, 2, 3, 11, 9, 5, 10, 1...
## $ periodicos_NA <int> 7, 15, 8, 11, 12, 6, 19, 31, 7, 14,...
## $ per_comaluno_A1 <int> 4, 1, 0, 0, 1, 7, 5, 0, 1, 0, 10, N...
## $ per_comaluno_A2 <int> 5, 5, 5, 0, 2, 15, 3, 0, 3, 0, 3, N...
## $ per_comaluno_B1 <int> 4, 2, 5, 2, 2, 14, 6, 0, 2, 0, 17, ...
## $ per_comaluno_B2 <int> 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1, NA...
## $ per_comaluno_B3 <int> 2, 2, 0, 1, 0, 7, 9, 0, 2, 0, 4, NA...
## $ per_comaluno_B4 <int> 0, 0, 0, 0, 2, 0, 1, 0, 1, 3, 0, NA...
## $ per_comaluno_B5 <int> 5, 0, 4, 0, 8, 3, 6, 0, 4, 0, 4, NA...
## $ per_comaluno_C <int> 6, 5, 3, 1, 2, 3, 7, 1, 2, 4, 8, NA...
## $ per_comaluno_NA <int> 6, 14, 2, 2, 9, 3, 6, 4, 5, 1, 10, ...dados <- dados_all %>%
replace(is.na(.), 0) %>%
mutate(periodicos_restrito = periodicos_A1 + periodicos_A2 + periodicos_B1) %>%
mutate(periodicos_qualis = periodicos_B1 + periodicos_B2 + periodicos_B3 + periodicos_B4 + periodicos_B5) %>%
select(instituicao = Instituição,
nivel = Nível,
colaboradores = `Docentes colaboradores`,
permanentes = `Docentes permanentes`,
artigos_conf = `Artigos em conf`,
dissertacoes = Dissertacoes,
teses = Teses,
periodicos_restrito,
periodicos_qualis)
dados %>% head()## # A tibble: 6 × 9
## instituicao nivel colaboradores permanentes
## <chr> <int> <dbl> <dbl>
## 1 UNIVERSIDADE FEDERAL DO AMAZONAS 5 0.25 24.75
## 2 UNIVERSIDADE FEDERAL DO PARÁ 4 5.50 14.00
## 3 UNIVERSIDADE FEDERAL DO MARANHÃO 3 3.00 10.00
## 4 UNIVERSIDADE ESTADUAL DO MARANHÃO 3 6.25 14.00
## 5 FUNDAÇÃO UNIVERSIDADE FEDERAL DO PIAUÍ 3 1.75 9.50
## 6 UNIVERSIDADE FEDERAL DO CEARÁ 5 2.00 20.75
## # ... with 5 more variables: artigos_conf <int>, dissertacoes <dbl>,
## # teses <dbl>, periodicos_restrito <int>, periodicos_qualis <int>dados %>%
select(-instituicao) %>%
summary()## nivel colaboradores permanentes artigos_conf
## Min. :3.000 Min. : 0.000 Min. : 3.00 Min. : 0.0
## 1st Qu.:3.000 1st Qu.: 1.125 1st Qu.:11.00 1st Qu.:121.5
## Median :3.000 Median : 3.000 Median :16.00 Median :187.0
## Mean :3.813 Mean : 3.990 Mean :20.22 Mean :239.6
## 3rd Qu.:4.000 3rd Qu.: 5.625 3rd Qu.:25.50 3rd Qu.:293.5
## Max. :7.000 Max. :22.250 Max. :67.25 Max. :959.0
## dissertacoes teses periodicos_restrito periodicos_qualis
## Min. : 0.00 Min. : 0.00 Min. : 0.00 Min. : 1.00
## 1st Qu.: 35.50 1st Qu.: 0.00 1st Qu.: 17.50 1st Qu.: 18.50
## Median : 56.00 Median : 0.00 Median : 40.00 Median : 32.00
## Mean : 73.77 Mean : 14.56 Mean : 56.87 Mean : 42.39
## 3rd Qu.:102.50 3rd Qu.: 14.00 3rd Qu.: 66.00 3rd Qu.: 53.00
## Max. :433.00 Max. :152.00 Max. :355.00 Max. :274.00dados %>%
summarise(sd(colaboradores), sd(permanentes), sd(artigos_conf), sd(dissertacoes), sd(teses), sd(periodicos_qualis), sd(periodicos_restrito))## # A tibble: 1 × 7
## `sd(colaboradores)` `sd(permanentes)` `sd(artigos_conf)`
## <dbl> <dbl> <dbl>
## 1 3.967444 12.35931 183.73
## # ... with 4 more variables: `sd(dissertacoes)` <dbl>, `sd(teses)` <dbl>,
## # `sd(periodicos_qualis)` <dbl>, `sd(periodicos_restrito)` <dbl>dados %>%
select(-instituicao) %>%
ggpairs()
dados %>%
ggplot(aes(x = nivel)) +
geom_bar()
dados %>%
top_n(10, dissertacoes) %>%
ggplot(aes(x = reorder(instituicao, dissertacoes), y = dissertacoes)) +
geom_bar(stat = "identity") +
coord_flip()
dados %>%
top_n(10, teses) %>%
ggplot(aes(x = reorder(instituicao, teses), y = teses)) +
geom_bar(stat = "identity") +
coord_flip()
dados %>%
top_n(10, artigos_conf) %>%
ggplot(aes(x = reorder(instituicao, artigos_conf), y = artigos_conf)) +
geom_bar(stat = "identity") +
coord_flip()
dados %>%
top_n(10, periodicos_qualis) %>%
ggplot(aes(x = reorder(instituicao, periodicos_qualis), y = periodicos_qualis)) +
geom_bar(stat = "identity") +
coord_flip()
dados %>%
top_n(10, periodicos_restrito) %>%
ggplot(aes(x = reorder(instituicao, periodicos_restrito), y = periodicos_restrito)) +
geom_bar(stat = "identity") +
coord_flip()
plot_nivel <- dados %>%
ggplot(aes(x = 0, y = nivel)) +
geom_point(alpha = 0.3)
plot_colaboradores <- dados %>%
ggplot(aes(x = 0, y = colaboradores)) +
geom_point(alpha = 0.3)
plot_permanentes <- dados %>%
ggplot(aes(x = 0, y = permanentes)) +
geom_point(alpha = 0.3)
plot_artigos_conf <- dados %>%
ggplot(aes(x = 0, y = artigos_conf)) +
geom_point(alpha = 0.3)
plot_dissertacoes <- dados %>%
ggplot(aes(x = 0, y = dissertacoes)) +
geom_point(alpha = 0.3)
plot_teses <- dados %>%
ggplot(aes(x = 0, y = teses)) +
geom_point(alpha = 0.3)
plot_per_qualis <- dados %>%
ggplot(aes(x = 0, y = periodicos_qualis)) +
geom_point(alpha = 0.3)
plot_per_restrito <- dados %>%
ggplot(aes(x = 0, y = periodicos_restrito)) +
geom_point(alpha = 0.3)
multiplot(plot_nivel, plot_colaboradores, plot_permanentes, plot_artigos_conf, plot_dissertacoes, plot_teses, plot_per_qualis, plot_per_restrito, cols = 4)
2. Clusterização
dados_pro <- dados %>%
mutate(colaboradores = as.vector(scale(colaboradores)),
permanentes = as.vector(scale(permanentes)),
artigos_conf = as.vector(scale(artigos_conf+1)),
dissertacoes = as.vector(scale(dissertacoes+1)),
teses = as.vector(scale(teses+1)),
periodicos_qualis = as.vector(scale(periodicos_qualis+1)),
periodicos_restrito = as.vector(scale(periodicos_restrito+1)))
dados_pro %>% head()## # A tibble: 6 × 9
## instituicao nivel colaboradores permanentes
## <chr> <int> <dbl> <dbl>
## 1 UNIVERSIDADE FEDERAL DO AMAZONAS 5 -0.9426725 0.36625548
## 2 UNIVERSIDADE FEDERAL DO PARÁ 4 0.3805977 -0.50353386
## 3 UNIVERSIDADE FEDERAL DO MARANHÃO 3 -0.2495310 -0.82717640
## 4 UNIVERSIDADE ESTADUAL DO MARANHÃO 3 0.5696363 -0.50353386
## 5 FUNDAÇÃO UNIVERSIDADE FEDERAL DO PIAUÍ 3 -0.5645953 -0.86763172
## 6 UNIVERSIDADE FEDERAL DO CEARÁ 5 -0.5015824 0.04261293
## # ... with 5 more variables: artigos_conf <dbl>, dissertacoes <dbl>,
## # teses <dbl>, periodicos_restrito <dbl>, periodicos_qualis <dbl>2.1 Clusterização Hierárquica
distancias = dados_pro %>%
select(-instituicao) %>%
dist(method = "maximum")
clust_hier <- distancias %>%
hclust(method = "ward.D")
ggdendrogram(clust_hier, rotate = TRUE)
plot(silhouette(cutree(clust_hier, k = 4), distancias))
atribuicoes <- cbind(dados_pro, grupo = cutree(clust_hier, k = 4))
atribuicoes %>%
select(-instituicao) %>%
ggparcoord(columns = c(1:8), groupColumn="grupo", scale = "globalminmax") +
facet_grid(paste("Grupo ", grupo) ~ .) +
theme(legend.position = "none") +
scale_y_continuous(breaks=c(0, 2, 4, 6))
2.2 K-Means
set.seed(1234)
explorando_k <- tibble(k = 2:12) %>%
group_by(k) %>%
do(
kmeans(select(dados_pro, -instituicao), centers = .$k, nstart = 20) %>% glance()
)
explorando_k %>%
ggplot(aes(x = k, y = tot.withinss)) +
geom_line() +
geom_point() +
scale_x_continuous(breaks=c(2:12))
explorando_k %>%
ggplot(aes(x = k, y = betweenss/totss)) +
geom_line() +
geom_point() +
scale_x_continuous(breaks = c(2:12))
km <- dados_pro %>%
select(-instituicao) %>%
kmeans(centers = 4, nstart = 20)
km %>%
augment(dados_pro) %>%
select(-instituicao) %>%
ggparcoord(columns = c(1:8), groupColumn = ".cluster", scale = "globalminmax") +
facet_grid(paste("Grupo ", .cluster) ~ .) +
ylab("Z-score") +
theme(legend.position = "none")
3. Redução da Dimensionalidade
Principal Component Analysis (PCA)
dados_pca <- dados_pro %>%
select(-instituicao) %>%
prcomp(scale = FALSE)
as.data.frame(dados_pca$rotation)## PC1 PC2 PC3 PC4
## nivel -0.3987424 -0.39555358 0.52035701 -0.3810568
## colaboradores -0.1695414 0.87508615 0.01662147 -0.2867285
## permanentes -0.3771071 0.01899928 -0.13278423 0.3423898
## artigos_conf -0.3700856 -0.05045480 -0.18916490 0.5057392
## dissertacoes -0.3444813 0.23179410 0.49771651 0.4396016
## teses -0.3724407 0.02779968 0.13314825 -0.3641500
## periodicos_restrito -0.3847241 -0.13351003 -0.26950427 -0.1122760
## periodicos_qualis -0.3573444 -0.05028613 -0.58090840 -0.2472224
## PC5 PC6 PC7 PC8
## nivel 0.45139603 -0.061567265 0.14935877 -0.19674669
## colaboradores 0.34877604 0.006328333 -0.01758259 -0.03156735
## permanentes 0.05036907 0.752704036 0.37063880 -0.12685934
## artigos_conf 0.32198135 -0.224705020 -0.58701560 -0.26492224
## dissertacoes -0.37559807 -0.375097007 0.27893822 0.16448305
## teses -0.59598147 0.281005984 -0.51732230 -0.09165590
## periodicos_restrito 0.14347490 -0.026733780 -0.05119914 0.85147105
## periodicos_qualis -0.22701321 -0.398417983 0.38389078 -0.33698477tidy(dados_pca, "pcs") %>%
ggplot(aes(x = PC, y = cumulative, label = cumulative)) +
geom_line() +
geom_point() +
geom_text(vjust = 1, hjust = -.1)
dados_pro_aug <- km %>% augment(dados)
dados_pca %>%
augment(dados_pro_aug) %>%
ggplot(aes(x = .fittedPC1, y = .fittedPC2, color = .cluster)) +
geom_point(alpha = 0.8) +
theme(legend.position = "none")
p = dados_pca %>%
augment(dados_pro_aug) %>%
hchart("scatter", hcaes(x = .fittedPC1, y = .fittedPC2, color = .cluster)) %>%
hc_tooltip(pointFormat = "<b>{point.instituicao}</b><br>
Nível: {point.nivel}<br>
Colaboradores: {point.colaboradores}<br>
Permanentes: {point.permanentes}<br>
Artigos Conf.: {point.artigos_conf}<br>
Dissertações: {point.dissertacoes}<br>
Teses: {point.teses}<br>
Per. A1-B1: {point.periodicos_restrito}<br>
Per. B2-B5: {point.periodicos_qualis}")
pautoplot(dados_pca, label = F, label.size = 3, shape = T, colour = km$cluster, loadings = TRUE, loadings.color = 'red', loadings.label = TRUE, loadings.label.size = 3, loadings.label.hjust=1.1)## Warning in if (value %in% columns) {: a condição tem comprimento > 1 e
## somente o primeiro elemento será usado
t-SNE
set.seed(1234)
tsne.out = dados_pro %>%
select(-instituicao) %>%
Rtsne(perplexity = 20)
df <- as.data.frame(tsne.out$Y)
dados_tsne <- cbind(dados_pro_aug, df)
dados_tsne %>%
ggplot(aes(x = V1, y = V2, color = .cluster)) +
geom_point(alpha = 0.8) +
theme(legend.position = "none")
p <- dados_tsne %>%
hchart("scatter", hcaes(x = V1, y = V2, color = .cluster)) %>%
hc_tooltip(pointFormat = "<b>{point.instituicao}</b><br>
Nível: {point.nivel}<br>
Colaboradores: {point.colaboradores}<br>
Permanentes: {point.permanentes}<br>
Artigos Conf.: {point.artigos_conf}<br>
Dissertações: {point.dissertacoes}<br>
Teses: {point.teses}<br>
Per. A1-B1: {point.periodicos_restrito}<br>
Per. B2-B5: {point.periodicos_qualis}")
p